perm filename SHFT.F4[MSS,LCS] blob sn#269280 filedate 1977-03-12 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		INTEGER PACK
C00004 ENDMK
CāŠ—;
	INTEGER PACK
	DIMENSION J(5)
4	TYPE 1
1	FORMAT(' TYPE  '$)
	ACCEPT 2,J
2	FORMAT(5A1)
	DO 5 K=1,5
5	IF(J(K).EQ.' ')PAUSE 'NO BLANKS ALLOWED!!!'
	K=PACK(J)
	TYPE 3,K
3	FORMAT(1XA5)
	GO TO 4
	END
	INTEGER FUNCTION PACK(JA)
	DIMENSION JA(5)
	DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
	DATA MM/"774000000000/
	JX=6
	DO 10 K=5,1,-1
10	IF(JA(K).EQ.' ')JX=K
	IA=JA(1)
	IF(IA)IA=MM.AND.JA(1)
	J2=2
7	IB=JA(J2)
	IBX=IB
	IF(IBX)IB=MM.AND.JA(J2)
11	K=IB.AND.LL
4 	K=K/KK
5	IF(IBX)K=K.OR.JJ
C  RESTORES LEFT HAND BIT (101 ETC.)
	IF(J2.EQ.2)GO TO 3
	DO 8 JL=1,J2-2
8	K=K/KK
3	N=IA.OR.K
	IA=N
	J2=J2+1
	IF(J2.NE.JX)GO TO 7
	PACK=N
	END